home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / guile-ii.src / guile-ii / guile-src / libguile / time.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-06-13  |  9.2 KB  |  450 lines
  1. /*    Copyright (C) 1995 Free Software Foundation, Inc.
  2.  * 
  3.  * This program is free software; you can redistribute it and/or modify
  4.  * it under the terms of the GNU General Public License as published by
  5.  * the Free Software Foundation; either version 2, or (at your option)
  6.  * any later version.
  7.  * 
  8.  * This program is distributed in the hope that it will be useful,
  9.  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11.  * GNU General Public License for more details.
  12.  * 
  13.  * You should have received a copy of the GNU General Public License
  14.  * along with this software; see the file COPYING.  If not, write to
  15.  * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  16.  *
  17.  * As a special exception, the Free Software Foundation gives permission
  18.  * for additional uses of the text contained in its release of GUILE.
  19.  *
  20.  * The exception is that, if you link the GUILE library with other files
  21.  * to produce an executable, this does not by itself cause the
  22.  * resulting executable to be covered by the GNU General Public License.
  23.  * Your use of that executable is in no way restricted on account of
  24.  * linking the GUILE library code into it.
  25.  *
  26.  * This exception does not however invalidate any other reasons why
  27.  * the executable file might be covered by the GNU General Public License.
  28.  *
  29.  * This exception applies only to the code released by the
  30.  * Free Software Foundation under the name GUILE.  If you copy
  31.  * code from other Free Software Foundation releases into a copy of
  32.  * GUILE, as the General Public License permits, the exception does
  33.  * not apply to the code that you add in this way.  To avoid misleading
  34.  * anyone as to the status of such modified files, you must delete
  35.  * this exception notice from them.
  36.  *
  37.  * If you write modifications of your own for GUILE, it is your choice
  38.  * whether to permit this exception to apply to your modifications.
  39.  * If you do not wish that, delete this exception notice.  
  40.  */
  41.  
  42.  
  43. #include <stdio.h>
  44. #include "_scm.h"
  45.  
  46.  
  47. #ifdef HAVE_CONFIG_H
  48.  
  49. # ifndef HAVE_FTIME
  50. #  define LACK_FTIME
  51. # endif
  52. # ifndef HAVE_TIMES
  53. #  define LACK_TIMES
  54. # endif
  55. # ifdef HAVE_SYS_TYPES_H
  56. #  include <sys/types.h>
  57. # endif
  58. # ifdef TIME_WITH_SYS_TIME
  59. #  include <sys/time.h>
  60. #  include <time.h>
  61. # else
  62. #  ifdef HAVE_SYS_TIME_H
  63. #   include <sys/time.h>
  64. #  else
  65. #   ifdef HAVE_TIME_H
  66. #    include <time.h>
  67. #   endif
  68. #  endif
  69. # endif
  70. # ifdef HAVE_SYS_TIMES_H
  71. #  include <sys/times.h>
  72. # else
  73. #  ifdef HAVE_SYS_TIMEB_H
  74. #   include <sys/timeb.h>
  75. #  endif
  76. # endif
  77. # ifdef HAVE_FTIME
  78. #  ifdef unix
  79. #   ifndef GO32
  80. #    include <sys/timeb.h>
  81. #   endif
  82. #  endif
  83. # endif
  84.  
  85. #else
  86.  
  87. # ifdef STDC_HEADERS
  88. #  include <time.h>
  89. #  ifdef M_SYSV
  90. #   include <sys/types.h>
  91. #   include <sys/times.h>
  92. #  endif
  93. #  ifdef sun
  94. #   include <sys/types.h>
  95. #   include <sys/times.h>
  96. #  endif
  97. #  ifdef ultrix
  98. #   include <sys/types.h>
  99. #   include <sys/times.h>
  100. #  endif
  101. #  ifdef nosve
  102. #   include <sys/types.h>
  103. #   include <sys/times.h>
  104. #  endif
  105. #  ifdef _UNICOS
  106. #   include <sys/types.h>
  107. #   include <sys/times.h>
  108. #  endif
  109. #  ifdef __IBMC__
  110. #   include <sys/timeb.h>
  111. #  endif
  112. # else
  113. #  ifdef SVR2
  114. #   include <time.h>
  115. #  else
  116. #   ifndef ARM_ULIB
  117. #    include <sys/time.h>
  118. #   else
  119. #    include <time.h>
  120. #   endif
  121. #  endif
  122. #  include <sys/types.h>
  123.  
  124. #  ifndef ARM_ULIB
  125. #   include <sys/times.h>
  126. #  else
  127. #   include <time.h>
  128. #  endif
  129.  
  130. # endif
  131.  
  132. /* Define this if your system lacks ftime(). */
  133. /* #define LACK_FTIME */
  134. /* Define this if your system lacks times(). */
  135. /* #define LACK_TIMES */
  136.  
  137. # ifdef __TURBOC__
  138. #  define LACK_TIMES
  139. # endif
  140. # ifdef ARM_ULIB
  141.  
  142. #  define LACK_FTIME
  143. #  define LACK_TIMES
  144. # endif
  145. # ifdef _DCC
  146. #  define LACK_FTIME
  147. # endif
  148. # if (__TURBOC__==1) /* Needed for TURBOC V1.0 */
  149. #  define LACK_FTIME
  150. #  undef MSDOS
  151. # endif
  152. # ifdef __HIGHC__
  153. #  define LACK_TIMES
  154. # endif
  155. # ifdef THINK_C
  156. #  define LACK_FTIME
  157. #  define LACK_TIMES
  158. #  define CLK_TCK 60
  159. # endif
  160. # ifdef SVR2
  161. #  define LACK_FTIME
  162. # endif
  163. # ifdef SVR4
  164. #  define LACK_FTIME
  165. # endif
  166. # ifdef nosve
  167. #  define LACK_FTIME
  168. # endif
  169. # ifdef GO32
  170. #  define LACK_FTIME
  171. #  define LACK_TIMES
  172. # endif
  173. # ifdef atarist
  174. #  define LACK_FTIME
  175. #  define LACK_TIMES
  176. # endif
  177. # ifdef MSDOS
  178. #  ifndef GO32
  179. #   include <sys/types.h>
  180. #   include <sys/timeb.h>
  181. #  endif
  182. # endif
  183. # ifdef _UNICOS
  184. #  define LACK_FTIME
  185. # endif
  186.  
  187. # ifndef LACK_FTIME
  188. #  ifdef unix
  189. #   ifndef GO32
  190. #    include <sys/timeb.h>
  191. #   endif
  192. #  endif
  193. # endif
  194.  
  195. # ifdef __EMX__
  196. #  define LACK_TIMES
  197. #  include <sys/types.h>
  198. #  include <sys/timeb.h>
  199. # endif
  200.  
  201. # ifdef MWC
  202. #  include <time.h>
  203. #  include <sys/timeb.h>
  204. # endif
  205.  
  206. # ifdef ARM_ULIB
  207. #  include <sys/types.h>
  208. #  include <time.h>
  209. # endif
  210.  
  211. #endif /* HAVE_CONFIG_H */
  212.  
  213. #ifdef vms
  214. # define LACK_TIMES
  215. # define LACK_FTIME
  216. #endif
  217.  
  218. #ifdef CLK_TCK
  219. # define CLKTCK CLK_TCK
  220. # ifdef CLOCKS_PER_SEC
  221. #  ifdef unix
  222. #   ifndef ARM_ULIB
  223. #    include <sys/times.h>
  224. #   endif
  225. #   define LACK_CLOCK
  226.     /* This is because clock() might be POSIX rather than ANSI.
  227.        This occurs on HP-UX machines */
  228. #  endif
  229. # endif
  230. #else
  231. # ifdef CLOCKS_PER_SEC
  232. #  define CLKTCK CLOCKS_PER_SEC
  233. # else
  234. #  define LACK_CLOCK
  235. #  ifdef AMIGA
  236. #   include <stddef.h>
  237. #   define LACK_TIMES
  238. #   define LACK_FTIME
  239. #   define CLKTCK 1000
  240. #  else
  241. #   define CLKTCK 60
  242. #  endif
  243. # endif
  244. #endif
  245.  
  246. #ifdef __STDC__
  247. # define timet time_t
  248. #else
  249. # define timet long
  250. #endif
  251.  
  252. #ifdef LACK_TIMES
  253. # ifdef LACK_CLOCK
  254. #  ifdef AMIGA
  255. /* From: "Fred Bayer" <bayerf@lan.informatik.tu-muenchen.de> */
  256. #   ifdef AZTEC_C        /* AZTEC_C */
  257. #    include <devices/timer.h>
  258. #ifdef __STDC__
  259. static long
  260. mytime(void)
  261. #else
  262. static long
  263. mytime()
  264. #endif
  265. {
  266.     long sec, mic, mili = 0;
  267.     struct timerequest *timermsg;
  268.     struct MsgPort *timerport;
  269.     if(!(timerport = (struct MsgPort *)CreatePort(0, 0))){
  270.     scm_lputs("No mem for port.\n", cur_errp);
  271.         return mili;
  272.     }
  273.     if(!(timermsg = (struct timerequest *)
  274.          CreateExtIO(timerport, sizeof(struct timerequest)))){
  275.         scm_lputs("No mem for timerequest.\n", cur_errp);
  276.         DeletePort(timermsg->tr_node.io_Message.mn_ReplyPort);
  277.     return mili;
  278.     }
  279.     if(!(OpenDevice(TIMERNAME, UNIT_MICROHZ, timermsg, 0))){
  280.         timermsg->tr_node.io_Command = TR_GETSYSTIME;
  281.         timermsg->tr_node.io_Flags = 0;
  282.         DoIO(timermsg);
  283.         sec = timermsg->tr_time.tv_secs;
  284.         mic = timermsg->tr_time.tv_micro;
  285.         mili = sec*1000+mic/1000;
  286.         CloseDevice(timermsg);
  287.     }
  288.     else scm_lputs("No Timer available.\n", cur_errp);
  289.     DeletePort(timermsg->tr_node.io_Message.mn_ReplyPort);
  290.     DeleteExtIO(timermsg);
  291.     return mili ;
  292. }
  293. #   else            /* this is for SAS/C */
  294. #ifdef __STDC__
  295. static
  296. long mytime(void)
  297. #else
  298. static
  299. long mytime()
  300. #endif
  301. {
  302.    unsigned int cl[2];
  303.    timer(cl);
  304.    return(cl[0]*1000+cl[1]/1000);
  305. }
  306. #   endif /* AZTEC_C */
  307. #  else /* AMIGA */
  308. #   define mytime() ((time((timet*)0) - scm_your_base) * CLKTCK)
  309. #  endif /* AMIGA */
  310. # else /* LACK_CLOCK */
  311. #  define mytime clock
  312. # endif /* LACK_CLOCK */
  313. #else /* LACK_TIMES */
  314. #ifdef __STDC__
  315. static
  316. long mytime(void)
  317. #else
  318. static
  319. long mytime()
  320. #endif
  321. {
  322.   struct tms time_buffer;
  323.   times(&time_buffer);
  324.   return time_buffer.tms_utime + time_buffer.tms_stime;
  325. }
  326. #endif /* LACK_TIMES */
  327.  
  328. #ifdef LACK_FTIME
  329. # ifdef AMIGA
  330. PROC (s_get_internal_real_time, "get-internal-real-time", 0, 0, 0, scm_get_internal_real_time);
  331. #ifdef __STDC__
  332. SCM
  333. scm_get_internal_real_time(void)
  334. #else
  335. SCM
  336. scm_get_internal_real_time()
  337. #endif
  338. {
  339.   return MAKINUM(mytime());
  340. }
  341. # else
  342. timet scm_your_base = 0;
  343. PROC (s_get_internal_real_time, "get-internal-real-time", 0, 0, 0, scm_get_internal_real_time);
  344. #ifdef __STDC__
  345. SCM
  346. scm_get_internal_real_time(void)
  347. #else
  348. SCM
  349. scm_get_internal_real_time()
  350. #endif
  351. {
  352.     return MAKINUM((time((timet*)0) - scm_your_base) * (int)CLKTCK);
  353. }
  354. # endif /* AMIGA */
  355. #else /* LACK_FTIME */
  356. struct timeb scm_your_base = {0};
  357. PROC (s_get_internal_real_time, "get-internal-real-time", 0, 0, 0, scm_get_internal_real_time);
  358. #ifdef __STDC__
  359. SCM
  360. scm_get_internal_real_time(void)
  361. #else
  362. SCM
  363. scm_get_internal_real_time()
  364. #endif
  365. {
  366.     struct timeb time_buffer;
  367.     long tmp;
  368.     ftime(&time_buffer);
  369.     time_buffer.time -= scm_your_base.time;
  370.     tmp = time_buffer.millitm - scm_your_base.millitm;
  371.     tmp = time_buffer.time*1000L + tmp;
  372.     tmp *= CLKTCK;
  373.     tmp /= 1000;
  374.     return MAKINUM(tmp);
  375. }
  376. #endif /* LACK_FTIME */
  377.  
  378. static long scm_my_base = 0;
  379.  
  380. PROC (s_get_internal_run_time, "get-internal-run-time", 0, 0, 0, scm_get_internal_run_time);
  381. #ifdef __STDC__
  382. SCM
  383. scm_get_internal_run_time(void)
  384. #else
  385. SCM
  386. scm_get_internal_run_time()
  387. #endif
  388. {
  389.   return MAKINUM(mytime()-scm_my_base);
  390. }
  391.  
  392. PROC (s_current_time, "current-time", 0, 0, 0, scm_current_time);
  393. #ifdef __STDC__
  394. SCM
  395. scm_current_time(void)
  396. #else
  397. SCM
  398. scm_current_time()
  399. #endif
  400. {
  401.   timet timv = time((timet*)0);
  402.   SCM ans;
  403. #ifndef _DCC
  404. # ifdef STDC_HEADERS
  405. #  if (__TURBOC__ > 0x201)
  406.   timv = mktime(gmtime(&timv));
  407. #  endif
  408. # endif
  409. #endif
  410.   ans = scm_ulong2num(timv);
  411.   return BOOL_F==ans ? MAKINUM(timv) : ans;
  412. }
  413.  
  414. #ifdef __STDC__
  415. long 
  416. scm_time_in_msec(long x)
  417. #else
  418. long 
  419. scm_time_in_msec(x)
  420.      long x;
  421. #endif
  422. {
  423.   if (CLKTCK==60) return (x*50)/3;
  424.   else
  425.     return (CLKTCK < 1000 ? x*(1000L/(long)CLKTCK) : (x*1000L)/(long)CLKTCK);
  426. }
  427.  
  428. #ifdef __STDC__
  429. void
  430. scm_init_time(void)
  431. #else
  432.      void
  433.      scm_init_time()
  434. #endif
  435. {
  436.   scm_sysintern("internal-time-units-per-second",
  437.         MAKINUM((long)CLKTCK));
  438. #ifdef LACK_FTIME
  439. # ifndef AMIGA
  440.   if (!scm_your_base) time(&scm_your_base);
  441. # endif
  442. #else
  443.   if (!scm_your_base.time) ftime(&scm_your_base);
  444. #endif
  445.   if (!scm_my_base) scm_my_base = mytime();
  446.  
  447. #include "time.x"
  448. }
  449.  
  450.